home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / seditEnriched.tcl.z / seditEnriched.tcl
Text File  |  2002-07-08  |  8KB  |  262 lines
  1. # seditEnriched.tcl
  2. #
  3. # Support for text/enriched display
  4. #
  5. # Copyright (c) 1994 Xerox Corporation.
  6. # Use and copying of this software and preparation of derivative works based
  7. # upon this software are permitted. Any distribution of this software or
  8. # derivative works must comply with all applicable United States export
  9. # control laws. This software is made available AS IS, and Xerox Corporation
  10. # makes no warranty about the software, its performance or its conformity to
  11. # any specification.
  12.  
  13. proc SeditMimeEnriched {look {draft {}} {t {}} } {
  14.     # Add text looks to the current selection
  15.     global mimeFont mime sedit
  16.     if {$draft == {}} {
  17.     set draft $sedit(draft)
  18.     }
  19.     if {$t == {}} {
  20.     set t $sedit(t)
  21.     }
  22.     if {$sedit($t,format) == "Never"} {
  23.     # Needed to get text/enriched output
  24.     set sedit($t,format) OnSend
  25.     }
  26.  
  27.     if [catch {$t tag names sel.first} tags] {
  28.     SeditMsg $t "No selection?"
  29.     return
  30.     }
  31.     if [$t compare [$t index header] > sel.first] {
  32.     SeditMsg $t "No looks in headers"
  33.     return
  34.     }
  35.     if {[lsearch $tags type=text/enriched] < 0} {
  36.     # First enriched text use - promote to text/enriched MIME type
  37.     SeditMimeType text/enriched promote
  38.     }
  39.     if {[string compare $look "x-plain"] == 0} {
  40.     Sedit_TagClear $t sel.first sel.last
  41.     } else {
  42.     Sedit_TagRange $t sel.first sel.last $look enriched
  43.     }
  44. }
  45.  
  46. proc SeditEnrichedExpand { t } {
  47.     # Add text/enriched formatting commands
  48.     set tags {}    ;# enriched text tags
  49.     foreach tag [$t tag names] {
  50.     if [regexp {Mime[0-9]+=(.+)} $tag] {
  51.         lappend tags $tag
  52.     }
  53.     if [regexp {Look[0-9]+} $tag] {
  54.         $t tag delete $tag
  55.     }
  56.     }
  57.     foreach mimetag $tags {
  58.     regexp {Mime[0-9]+=(.+)} $mimetag match tag
  59.     if {$tag == "x-plain"} {
  60.         continue
  61.     }
  62.     set range [$t tag nextrange $mimetag 1.0]
  63.     while {$range != {}} {
  64.         set first [lindex $range 0]
  65.         set last [lindex $range 1]
  66.         $t mark set first $first    ;# need a floating mark
  67.         $t tag remove $mimetag $first $last
  68.         $t insert $last </$tag>
  69.         $t insert $first <$tag>
  70.         foreach tag2 [$t tag names first] {
  71.         if [regexp {Mime[0-9]+=(.+)} $tag2 match tagName] {
  72.             # bleed the other mark backwards, over <tag> just inserted
  73.             set len [string length <$tag>]
  74.             $t tag add $match "first - $len chars" first
  75.         }
  76.         }
  77.         set range [$t tag nextrange $mimetag 1.0]
  78.     }
  79.     }
  80. }
  81.  
  82. proc Sedit_TagRange { t start end key type } {
  83.     global rich
  84.     #
  85.     # Called from a composer to set looks in a text widget.
  86.     #
  87.     SeditMimeTag $t $start $end $key
  88.     SeditRichReset $t
  89.     #
  90.     # The Looks for the range are a function of existing looks within
  91.     # the range.  So, this new range will break up pre-existing looks
  92.     # ranges and modify them.  The Looks tag includes the formatting
  93.     # stack needed to compute the proper looks.
  94.     #
  95.     set end [$t index $end]
  96.     set start [$t index $start]
  97.     set rich($t,lookMark) $start
  98.     set curStack $key
  99.     set forwMark {}
  100.     Exmh_Debug Sedit_TagRange $start $end $key
  101.     Exmh_Debug Stack := $curStack
  102.     for {set ix $start} {[$t compare $ix < $end]} {set ix [$t index "$ix +1c"]} {
  103.     foreach tag [$t tag names $ix] {
  104.         if [regexp {Look=(.+)} $tag match stack] {
  105.         Exmh_Debug $tag | $rich($t,lookMark) $ix cur=$curStack new=$stack
  106.         SeditRichLooks $t $rich($t,lookMark) $ix $curStack
  107.         set rich($t,lookMark) $ix
  108.         set curStack $stack
  109.         lappend curStack $key
  110.         Exmh_Debug Stack => $curStack
  111.         set range [$t tag nextrange $tag $ix]
  112.         if {$range != {}} {
  113.             Exmh_Debug $t tag remove $tag $range
  114.             eval {$t tag remove $tag} $range
  115.             set forwMark [lindex $range 1]
  116.         }
  117.         continue
  118.         }
  119.         if {$ix == $forwMark} {
  120.         # end of previously found range
  121.         Exmh_Debug <forw> | $rich($t,lookMark) $ix $curStack
  122.         SeditRichLooks $t $rich($t,lookMark) $ix $curStack
  123.         set rich($t,lookMark) $ix
  124.         # Assert, only get here if no Looks ahead, so stack is just $key
  125.         set curStack $key
  126.         Exmh_Debug Stack => $curStack
  127.         }
  128.     }
  129.     }
  130.     Exmh_Debug Stack := $curStack
  131.     Exmh_Debug <end> | $rich($t,lookMark) $ix $curStack
  132.     SeditRichLooks $t $rich($t,lookMark) $end $curStack
  133. }
  134. proc Sedit_TagClear { t start end } {
  135.     global rich
  136.     #
  137.     # Called from a composer to clear looks in a text widget.
  138.     #
  139.     SeditRichReset $t
  140.     #
  141.     # The Looks for the range are a function of existing looks within
  142.     # the range.  So, this new range will break up pre-existing looks
  143.     # ranges and modify them.  The Looks tag includes the formatting
  144.     # stack needed to compute the proper looks.
  145.     #
  146.     set end [$t index $end]
  147.     set start [$t index $start]
  148.     set rich($t,lookMark) $start
  149.     set forwMark {}
  150.     Exmh_Debug Sedit_TagClear $start $end
  151.     for {set ix $start} {[$t compare $ix < $end]} {set ix [$t index "$ix +1c"]} {
  152.     foreach tag [$t tag names $ix] {
  153.         if [regexp {Look=(.+)} $tag match stack] {
  154.         $t tag remove $tag $ix $end
  155.         }
  156.         if [regexp {Mime[0-9]+=(.+)} $tag match stack] {
  157.         $t tag remove $tag $ix $end
  158.         }
  159.     }
  160.     }
  161. }
  162.  
  163. proc SeditRichReset { t } {
  164.     global rich
  165.     set rich($t,family) times
  166.     set rich($t,sizes) {60 80 100 120 140 180 240}
  167.     set rich($t,size) 120
  168.     set rich($t,weight) medium
  169.     set rich($t,slant) r
  170.     set rich($t,underline) 0
  171.     set rich($t,color) [option get $t foreground {}]
  172.     if ![info exists rich($t,stack)] {
  173.     set rich($t,stack) {}
  174.     }
  175. }
  176. proc SeditMimeTag { t start end key } {
  177.     global rich
  178.     #
  179.     # The Mime=foo tag is used when generating enriched text output.
  180.     # They simply delimit the range to which a single look applies.
  181.     # Used by SeditEnrichedExpand
  182.     #
  183.     if [info exists rich($t,mimetagcnt)] {
  184.     set rich($t,mimetagcnt) [incr rich($t,mimetagcnt)]
  185.     } else {
  186.     set rich($t,mimetagcnt) 1
  187.     }
  188.     if [info exists rich($t,lastmark)] {
  189.     if [$t compare $start > "$rich($t,lastmark) +1 c"] {
  190.         #
  191.         # Undo the tag in gaps between commands so that
  192.         # formatting does not "bleed" with inserted characters
  193.         #
  194.         $t tag remove $rich($t,lasttag) "$rich($t,lastmark) +1 c" $start
  195.     }
  196.     set rich($t,lastmark) $end
  197.     set rich($t,lasttag) Mime$rich($t,mimetagcnt)=$key
  198.     }
  199.     $t tag add Mime$rich($t,mimetagcnt)=$key $start $end
  200. }
  201. proc SeditRichLooks { t start end stack } {
  202.     global rich
  203.     if {$start == $end} {
  204.     return
  205.     }
  206.     SeditLooksFromStack $t $stack
  207.     set font *-$rich($t,family)-$rich($t,weight)-$rich($t,slant)-*-*-*-$rich($t,size)-*-*-*-*-iso8859-*
  208.     $t tag configure Look=$stack -underline $rich($t,underline)
  209.     if [catch {
  210.     $t tag configure Look=$stack -font $font 
  211.     } err] {
  212.     $t tag configure Look=$stack -font fixed \
  213.         -foreground black -background white
  214.     }
  215.     if [catch {
  216.     $t tag configure Look=$stack -foreground $rich($t,color)
  217.     } err] {
  218.     $t tag configure Look=$stack -foreground black -background white
  219.     }
  220.     $t tag add Look=$stack $start $end
  221.     #
  222.     # This is used to undo look "bleeding" into subsequently inserted chars.
  223.     #
  224.     set rich($t,lastLook) Look=$stack
  225.     set rich($t,lastLookEnd) $end
  226. }
  227. proc SeditLooksFromStack { t stack } {
  228.     global rich
  229.     set ignore 0
  230.     SeditRichReset $t
  231.     foreach look $stack {
  232.     case $look {
  233.         default { incr ignore }
  234.         =* {
  235.         set paramval [string range $look 1 end]
  236.         set needsParam $paramval
  237.         }
  238.         x-plain { SeditRichReset $t }
  239.         x-color { set needsParam rich($t,color) }
  240.         fixed { set rich($t,family) courier }
  241.         underline { set rich($t,underline) 1 }
  242.         bold { set rich($t,weight) bold }
  243.         italic { set rich($t,slant) i }
  244.         smaller {
  245.         set ix [lsearch $rich($t,sizes) $rich($t,size)]
  246.         if {$ix > 0} {
  247.             incr ix -1
  248.             set rich($t,size) [lindex $rich($t,sizes) $ix]
  249.         }
  250.         }
  251.         bigger {
  252.         set ix [lsearch $rich($t,sizes) $rich($t,size)]
  253.         incr ix
  254.         if {$ix < [llength $rich($t,sizes)]} {
  255.             set rich($t,size) [lindex $rich($t,sizes) $ix]
  256.         }
  257.         }
  258.     }
  259.     }
  260.     return ignore
  261. }
  262.